home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Resize_Ima1734264162004.psc / Resize Image Dimensions / Resize Image.frm < prev    next >
Text File  |  2004-04-16  |  8KB  |  220 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Resize Image Dimensions"
  4.    ClientHeight    =   8715
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   14235
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   8715
  10.    ScaleWidth      =   14235
  11.    StartUpPosition =   2  'CenterScreen
  12.    Begin VB.PictureBox Picture1 
  13.       Height          =   465
  14.       Left            =   6825
  15.       ScaleHeight     =   405
  16.       ScaleWidth      =   405
  17.       TabIndex        =   7
  18.       Top             =   5400
  19.       Width           =   465
  20.    End
  21.    Begin VB.VScrollBar vsbHeight 
  22.       Height          =   5265
  23.       LargeChange     =   150
  24.       Left            =   6825
  25.       Max             =   5000
  26.       Min             =   500
  27.       SmallChange     =   10
  28.       TabIndex        =   4
  29.       Top             =   150
  30.       Value           =   500
  31.       Width           =   465
  32.    End
  33.    Begin VB.HScrollBar hsbWidth 
  34.       Height          =   465
  35.       LargeChange     =   150
  36.       Left            =   75
  37.       Max             =   6600
  38.       Min             =   500
  39.       SmallChange     =   10
  40.       TabIndex        =   3
  41.       Top             =   5400
  42.       Value           =   500
  43.       Width           =   6765
  44.    End
  45.    Begin VB.PictureBox picImage 
  46.       Appearance      =   0  'Flat
  47.       AutoSize        =   -1  'True
  48.       BackColor       =   &H80000005&
  49.       BorderStyle     =   0  'None
  50.       ForeColor       =   &H80000008&
  51.       Height          =   7200
  52.       Left            =   7425
  53.       Picture         =   "Resize Image.frx":0000
  54.       ScaleHeight     =   7200
  55.       ScaleWidth      =   6675
  56.       TabIndex        =   2
  57.       Top             =   150
  58.       Width           =   6675
  59.    End
  60.    Begin VB.CommandButton cmdResizeImage 
  61.       Caption         =   "Resize Image and paint it"
  62.       Default         =   -1  'True
  63.       Height          =   615
  64.       Left            =   75
  65.       TabIndex        =   1
  66.       Top             =   7950
  67.       Width           =   7215
  68.    End
  69.    Begin VB.PictureBox picBox 
  70.       Appearance      =   0  'Flat
  71.       BackColor       =   &H80000001&
  72.       BorderStyle     =   0  'None
  73.       ForeColor       =   &H80000008&
  74.       Height          =   5190
  75.       Left            =   75
  76.       ScaleHeight     =   5190
  77.       ScaleWidth      =   6690
  78.       TabIndex        =   0
  79.       Top             =   150
  80.       Width           =   6690
  81.    End
  82.    Begin VB.Label lblDestHeight 
  83.       Caption         =   "Destination Height :"
  84.       BeginProperty Font 
  85.          Name            =   "MS Sans Serif"
  86.          Size            =   9.75
  87.          Charset         =   0
  88.          Weight          =   700
  89.          Underline       =   0   'False
  90.          Italic          =   0   'False
  91.          Strikethrough   =   0   'False
  92.       EndProperty
  93.       Height          =   315
  94.       Left            =   75
  95.       TabIndex        =   9
  96.       Top             =   6450
  97.       Width           =   7215
  98.    End
  99.    Begin VB.Label lblDestWidth 
  100.       Caption         =   "Destination Width :"
  101.       BeginProperty Font 
  102.          Name            =   "MS Sans Serif"
  103.          Size            =   9.75
  104.          Charset         =   0
  105.          Weight          =   700
  106.          Underline       =   0   'False
  107.          Italic          =   0   'False
  108.          Strikethrough   =   0   'False
  109.       EndProperty
  110.       Height          =   315
  111.       Left            =   75
  112.       TabIndex        =   8
  113.       Top             =   6000
  114.       Width           =   7215
  115.    End
  116.    Begin VB.Label lblNewAspectRatio 
  117.       Caption         =   "New Aspect Ratio :"
  118.       BeginProperty Font 
  119.          Name            =   "MS Sans Serif"
  120.          Size            =   9.75
  121.          Charset         =   0
  122.          Weight          =   700
  123.          Underline       =   0   'False
  124.          Italic          =   0   'False
  125.          Strikethrough   =   0   'False
  126.       EndProperty
  127.       Height          =   315
  128.       Left            =   75
  129.       TabIndex        =   6
  130.       Top             =   7350
  131.       Width           =   7215
  132.    End
  133.    Begin VB.Label lblOldAspectRatio 
  134.       Caption         =   "Original Aspect Ratio :"
  135.       BeginProperty Font 
  136.          Name            =   "MS Sans Serif"
  137.          Size            =   9.75
  138.          Charset         =   0
  139.          Weight          =   700
  140.          Underline       =   0   'False
  141.          Italic          =   0   'False
  142.          Strikethrough   =   0   'False
  143.       EndProperty
  144.       Height          =   315
  145.       Left            =   75
  146.       TabIndex        =   5
  147.       Top             =   6900
  148.       Width           =   7215
  149.    End
  150. End
  151. Attribute VB_Name = "Form1"
  152. Attribute VB_GlobalNameSpace = False
  153. Attribute VB_Creatable = False
  154. Attribute VB_PredeclaredId = True
  155. Attribute VB_Exposed = False
  156. Option Explicit
  157.  
  158. '//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  159. '/// This program resizes the image's width and height based on the
  160. '/// destination's width and height while maintaining aspect ratio.
  161. '/// The image's aspect ratio is defined as : Aspect Ratio = Image's Height / Image's Width
  162. '//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  163.  
  164. '//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  165. '/// NOTE : No error-handling included
  166. '//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  167.  
  168. Private Sub cmdResizeImage_Click()
  169.       Dim ImageWidth As Single      'Original image's width
  170.       Dim ImageHeight As Single     'Original image's height
  171.       Dim ResizedWidth As Single     'Resized image's width
  172.       Dim ResizedHeight As Single    'Resized image's height
  173.       Dim DestWidth As Single         'Destination picturebox's width
  174.       Dim DestHeight As Single         'Destination picturebox's height
  175.       Dim AspectRatio As Single        'Image's aspect ratio ( NOTE : aspect ratio = height / width )
  176.       
  177.       'Destination picturebox's dimensions
  178.       DestWidth = picBox.Width
  179.       DestHeight = picBox.Height
  180.       
  181.       'Stores the image's original dimensions
  182.       ImageWidth = picImage.Width
  183.       ImageHeight = picImage.Height
  184.       
  185.       'Initializes the resized dimensions
  186.       ResizedWidth = ImageWidth
  187.       ResizedHeight = ImageHeight
  188.                   
  189.       'Calculate image's original aspect ratio and display it in lblOldAspectRatio
  190.       AspectRatio = (ImageHeight / ImageWidth)
  191.       lblOldAspectRatio = "Original Aspect Ratio : " & AspectRatio
  192.       
  193.       'Now resize the dimensions...
  194.       Call AdjustImageDimensions(ResizedWidth, ResizedHeight, DestWidth, DestHeight)
  195.       
  196.       'Calculate image's new aspect ratio and display it in lblNewAspectRatio
  197.       AspectRatio = (ResizedHeight / ResizedWidth)
  198.       lblNewAspectRatio = "New Aspect Ratio : " & AspectRatio
  199.       
  200.       'Paint the image onto picBox
  201.       picBox.Cls
  202.       picBox.PaintPicture picImage.Picture, 0, 0, ResizedWidth, ResizedHeight
  203.                                 
  204. End Sub
  205.  
  206. Private Sub Form_Load()
  207.       hsbWidth.Value = hsbWidth.Max
  208.       vsbHeight.Value = vsbHeight.Max
  209. End Sub
  210.  
  211. Private Sub vsbHeight_Change()
  212.       picBox.Height = vsbHeight.Value
  213.       lblDestHeight = "Destination Height : " & picBox.Height
  214. End Sub
  215.  
  216. Private Sub hsbWidth_Change()
  217.       picBox.Width = hsbWidth.Value
  218.       lblDestWidth = "Destination Width : " & picBox.Width
  219. End Sub
  220.